home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / DSCANNER.ZIP / TEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-08  |  4.6 KB  |  206 lines
  1. unit Test;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Grids, Outline, Dropfile, Explorer, DScan,
  8.   FileCtrl;
  9.  
  10. type
  11.  
  12.   TTstForm = class(TForm)
  13.     NM: TLabel;
  14.     Parse: TButton;
  15.     attr: TEdit;
  16.     LFN: TDirScanner;
  17.     Drives: TDriveComboBox;
  18.     Dirs: TDirectoryListBox;
  19.     GroupBox1: TGroupBox;
  20.     GroupBox2: TGroupBox;
  21.     isLFN: TRadioButton;
  22.     toLongName: TButton;
  23.     FLIST: TStringGrid;
  24.     GroupBox3: TGroupBox;
  25.     Label1: TLabel;
  26.     FOnly: TButton;
  27.     DOnly: TButton;
  28.     DnF: TButton;
  29.     VID: TButton;
  30.     GroupBox4: TGroupBox;
  31.     pttrn: TEdit;
  32.     Label2: TLabel;
  33.     FFirst: TButton;
  34.     FNext: TButton;
  35.     Use: TCheckBox;
  36.     Keep: TCheckBox;
  37.     Label3: TLabel;
  38.     xxx: TLabel;
  39.     procedure UseClick(Sender: TObject);
  40.     procedure KeepClick(Sender: TObject);
  41.     procedure ParseClick(Sender: TObject);
  42.     procedure isLFNClick(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure DirsDblClick(Sender: TObject);
  45.     procedure toLongNameClick(Sender: TObject);
  46.     procedure FOnlyClick(Sender: TObject);
  47.     procedure DOnlyClick(Sender: TObject);
  48.     procedure DnFClick(Sender: TObject);
  49.     procedure VIDClick(Sender: TObject);
  50.     procedure FFirstClick(Sender: TObject);
  51.     procedure FNextClick(Sender: TObject);
  52.   private
  53.     { Private declarations }
  54.   public
  55.     { Public declarations }
  56.   end;
  57.  
  58. var
  59.   TstForm: TTstForm;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. procedure pp_roc( var fName:String; attr: Word); far;
  66. begin
  67. if (attr AND $10) <> 0 then
  68.   fName := '['+fName+']';
  69. end;
  70.  
  71.  
  72. procedure TTstForm.UseClick(Sender: TObject);
  73. begin
  74. LFN.UseLongFileNames := Use.Checked;
  75. end;
  76.  
  77. procedure TTstForm.KeepClick(Sender: TObject);
  78. begin
  79. LFN.KeepExtension := Keep.Checked;
  80. end;
  81.  
  82. procedure TTstForm.ParseClick(Sender: TObject);
  83. var
  84.   p, s: String;
  85.   attr_, rAttr: Word;
  86.   ts : TStringList;
  87.   p__:TParserPreprocessor;
  88.   i: Integer;
  89. begin
  90. attr_ := Word(StrToInt( attr.Text ));
  91. p := Dirs.Directory;
  92. if p[Length(p)] = '\' then
  93.   p := p + '*.*'
  94. else
  95.   p := p + '\*.*';
  96.  
  97. ts := TStringList.create;
  98. ts.Clear;
  99. p__ := pp_roc;
  100. LFN.loadFileList_PP( ts, p, attr_, p__, True);
  101. ts.Sort;
  102. { here comes the formatting and adding of the items }
  103. FLIST.RowCount := ts.Count+1;
  104. for i := 0 to ts.Count-1 do
  105.   begin
  106.   FLIST.Cols[0][i+1] := ts.Strings[i];
  107.   with ts.Objects[i] as TDirItemData do
  108.     begin
  109.     FmtStr( s, '%2.2d-%2.2d-%4.4d', [Integer(lastAccess.Month), Integer(lastAccess.Day), Integer(lastAccess.Year_1980)+1980]);
  110.     FLIST.Cols[2][i+1] := s;
  111.     FmtStr( s, '%2.2d:%2.2d:%2.2d', [Integer(lastAccess.Hour), Integer(lastAccess.Min), Integer(lastAccess.Sec)]);
  112.     FLIST.Cols[3][i+1] := s;
  113.     FmtStr( s, '%d', [FSize] );
  114.     FLIST.Cols[1][i+1] := s;
  115.     end;
  116.   end;
  117.  
  118. ts.destroy;
  119. end;
  120.  
  121. procedure TTstForm.isLFNClick(Sender: TObject);
  122. begin
  123. isLFN.Checked := LFN.isLFNsystem;
  124.  
  125. end;
  126.  
  127. procedure TTstForm.FormCreate(Sender: TObject);
  128. begin
  129. isLFN.Checked := LFN.isLFNsystem;
  130. FLIST.Rows[0][0] := 'Name';
  131. FLIST.Rows[0][1] := 'Size';
  132. FLIST.Rows[0][2] := 'Cr. Dat';
  133. FLIST.Rows[0][3] := 'Cr. Time';
  134. Use.Checked := True;
  135. Keep.Checked := True;
  136. end;
  137.  
  138. procedure TTstForm.DirsDblClick(Sender: TObject);
  139. begin
  140. NM.Caption := Dirs.Directory;
  141. end;
  142.  
  143. procedure TTstForm.toLongNameClick(Sender: TObject);
  144. begin
  145. NM.Caption := LFN.LFNfromSFN( NM.CAption );
  146. end;
  147.  
  148. procedure TTstForm.FOnlyClick(Sender: TObject);
  149. begin
  150. attr.Text := '$'+IntToHex( lfnFilesOnly, 4 );
  151. end;
  152.  
  153. procedure TTstForm.DOnlyClick(Sender: TObject);
  154. begin
  155. attr.Text := '$'+IntToHex( lfnDirectoriesOnly, 4 );
  156. end;
  157.  
  158. procedure TTstForm.DnFClick(Sender: TObject);
  159. begin
  160. attr.Text := '$'+IntToHex( lfnFilesAndDirs, 4 );
  161. end;
  162.  
  163. procedure TTstForm.VIDClick(Sender: TObject);
  164. begin
  165. attr.Text := '$'+IntToHex( lfnVolumeIDOnly, 4 );
  166. end;
  167.  
  168. procedure TTstForm.FFirstClick(Sender: TObject);
  169. var
  170.   p, s: String;
  171.   rAttr, attr_: Word;
  172. begin
  173. FLIST.RowCount := 1;
  174. FLIST.RowCount := 2;
  175. FList.Rows[1].Clear;
  176.  
  177. attr_ := Word(StrToInt( attr.Text ));
  178. p := Dirs.Directory;
  179. if p[Length(p)] = '\' then
  180.   p := p + pttrn.Text
  181. else
  182.   p := p + '\'+ pttrn.Text;
  183.  
  184. FNext.Enabled := LFN.FindFirstFileName( p, attr_, s, rAttr );
  185. if FNext.Enabled then
  186.   begin
  187.   FLIST.Rows[1][0] := s;
  188.   end;
  189. FList.FixedRows := 1;
  190. end;
  191.  
  192. procedure TTstForm.FNextClick(Sender: TObject);
  193. var
  194.   s: String;
  195.   rAttr: Word;
  196. begin
  197. FNext.Enabled := LFN.FindNextFileName( s, rAttr );
  198. if FNext.Enabled then
  199.   begin
  200.   FLIST.RowCount := FLIST.RowCount+1;
  201.   FLIST.Rows[FLIST.RowCount-1][0] := s;
  202.   end;
  203. end;
  204.  
  205. end.
  206.